home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / unix / tkUnixInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-19  |  2.8 KB  |  108 lines
  1. /* 
  2.  * tkUnixInit.c --
  3.  *
  4.  *    This file contains Unix-specific interpreter initialization
  5.  *    functions.
  6.  *
  7.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tkUnixInit.c 1.10 96/04/11 09:50:34
  13.  */
  14.  
  15. #include "tkInt.h"
  16. #include "tkUnixInt.h"
  17.  
  18. #ifndef STk_CODE
  19. /*
  20.  * Default directory in which to look for libraries:
  21.  */
  22.  
  23. static char defaultLibraryDir[200] = TK_LIBRARY;
  24.  
  25. /*
  26.  * The following string is the startup script executed in new
  27.  * interpreters.  It looks on disk in several different directories
  28.  * for a script "tk.tcl" that is compatible with this version
  29.  * of Tk.  The tk.tcl script does all of the real work of
  30.  * initialization.
  31.  */
  32.  
  33. static char *initScript =
  34. "proc init {} {\n\
  35.     global tk_library tk_version tk_patchLevel env\n\
  36.     rename init {}\n\
  37.     set dirs {}\n\
  38.     if [info exists env(TK_LIBRARY)] {\n\
  39.     lappend dirs $env(TK_LIBRARY)\n\
  40.     }\n\
  41.     lappend dirs $tk_library\n\
  42.     lappend dirs [file dirname [info library]]/lib/tk$tk_version\n\
  43.     lappend dirs [file dirname [file dirname [info nameofexecutable]]]/lib/tk$tk_version\n\
  44.     if [string match {*[ab]*} $tk_patchLevel] {\n\
  45.     set lib tk$tk_patchLevel\n\
  46.     } else {\n\
  47.     set lib tk$tk_version\n\
  48.     }\n\
  49.     lappend dirs [file dirname [file dirname [pwd]]]/$lib/library\n\
  50.     lappend dirs [file dirname [file dirname [info library]]]/$lib/library\n\
  51.     lappend dirs [file dirname [pwd]]/library\n\
  52.     foreach i $dirs {\n\
  53.     set tk_library $i\n\
  54.     if ![catch {uplevel #0 source $i/tk.tcl}] {\n\
  55.         return\n\
  56.     }\n\
  57.     }\n\
  58.     set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
  59.     append msg \"    $dirs\n\"\n\
  60.     append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
  61.     error $msg\n\
  62. }\n\
  63. init";
  64. #endif
  65.  
  66. /*
  67.  *----------------------------------------------------------------------
  68.  *
  69.  * TkPlatformInit --
  70.  *
  71.  *    Performs Unix-specific interpreter initialization related to the
  72.  *      tk_library variable.
  73.  *
  74.  * Results:
  75.  *    Returns a standard Tcl result.  Leaves an error message or result
  76.  *    in interp->result.
  77.  *
  78.  * Side effects:
  79.  *    Sets "tk_library" Tcl variable, runs "tk.tcl" script.
  80.  *
  81.  *----------------------------------------------------------------------
  82.  */
  83.  
  84. int
  85. TkPlatformInit(interp)
  86.     Tcl_Interp *interp;
  87. {
  88.     char *libDir;
  89.  
  90. #ifdef STk_CODE
  91.     extern char *STk_library_path;
  92.     
  93.     Tcl_SetVar(interp, "*stk-library*", STk_library_path, 
  94.            STk_STRINGIFY | TCL_GLOBAL_ONLY);
  95. #else
  96.     libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
  97.     if (libDir == NULL) {
  98.     Tcl_SetVar(interp, "tk_library", defaultLibraryDir, TCL_GLOBAL_ONLY);
  99.     }
  100. #endif
  101.     TkCreateXEventSource();
  102. #ifdef STk_CODE
  103.     return TCL_OK;
  104. #else
  105.     return Tcl_Eval(interp, initScript);
  106. #endif
  107. }
  108.